PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/frame3.exe/STATIC.PAS

Pascal/Delphi Source File | 1993-02-13 | 8.0 KB | 278 lines

{$A+}   { Align data }
{$B-}   { Boolean evaluation }
{$E+}   { 80x87 emulator }
{$F-}   { Force FAR calls }
{$G+}   { 80286 code }
{$I-}   { I/O checking }
{$K+}   { Smart Callbacks }
{$N-}   { 80x87 code }
{$O-}   { Overlays allowed }
{$P-}   { Open parameters }
{$T-}   { Typed pointers }
{$V-}   { String VAR checking }
{$W-}   { Windows stack frame for real mode }
{$X+}   { Extended syntax }

{$IFDEF DEBUG}
    {$D+}   { Debug information }
    {$L+}   { Local symbols }
    {$Q+}   { Overflow checking }
    {$R+}   { Range checking }
    {$S+}   { Stack checking }
    {$Y+}   { Symbol reference information }
{$ELSE}
    {$D-}   { Debug information }
    {$L-}   { Local symbols }
    {$Q-}   { Overflow checking }
    {$R-}   { Range checking }
    {$S-}   { Stack checking }
    {$Y-}   { Symbol reference information }
{$ENDIF}

{$C Moveable Demandload Discardable} { Code Segment attributes }

{$M 8192,4096}

PROGRAM StaticTest;

{
  Copyright (c) 1993 by Olaf He▀ (Hess), Munich, Germany.

  Please feel free to use this code in your own programs.
  If you make $$$ with it ->> You have my ID!
  If you find any bugs or do any changes to the source code that you find
  generally useful please send me a message to my CompuServe account
  100 031, 35 36.

  Thanks.
}

{$R STATIC.RES}

{$D StaticTest by Olaf Hess}

USES WinTypes, WinProcs, OWindows, ODialogs, WinDos, CommDlg,
     FrameDlg, Stat_Ids;

CONST
    szAppName = 'StaticTest';
    szClassName = 'StaticTestClass';

TYPE
    TStaticApp = OBJECT (TApplication)
        PROCEDURE InitMainWindow; VIRTUAL;
    END; { TStaticApp }

    PStaticWindow = ^TStaticWindow;
    TStaticWindow = OBJECT (TSteelDlgWnd)
        pToStaticUp : PStaticUp;
        pToStaticDown : PStaticDown;
        pToFrameUp : PFrameUp;
        pToFrameDown : PFrameDown;

        CONSTRUCTOR Init (AParent: PWindowsObject; ATitle: PChar);

        PROCEDURE SetupWindow; VIRTUAL;
        PROCEDURE GetWindowClass (VAR AWndClass: TWndClass); VIRTUAL;
        FUNCTION GetClassName : PChar; VIRTUAL;

        PROCEDURE wmCommand (VAR Msg: TMessage);
            VIRTUAL wm_First + wm_Command;

        PROCEDURE idChooseFile (VAR Msg: TMessage);
            VIRTUAL id_First + id_ChooseFile;
    END; { TStaticWindow }

(* ---- *)

FUNCTION FileOpenHook (hDlgWin: hWnd; Msg, wParam: Word;
                       lParam: LongInt) : Word; EXPORT;
{ Hook procedure for the common dialog file open dialog. Note that this
  function has to be marked as EXPORT and that Smart Callbacks must be
  enabled: $K+ }

BEGIN
    FileOpenHook := 0; { Default processing }

    CASE Msg OF
        wm_InitDialog : FileOpenHook := 1; { Don't pass through }

        wm_CtlColor :
            BEGIN
                IF (NOT fDoColors) THEN Exit; { Enough colors? }

                CASE HiWord (lParam) OF

                    CtlColor_Dlg :
                        { Brush for the dialog background }
                        FileOpenHook := hBackgroundBrush;

                    CtlColor_ScrollBar,
                    CtlColor_MsgBox,
                    CtlColor_Static :
                        BEGIN
                            { Brush for the background }
                            FileOpenHook := GetStockObject (LTGRAY_BRUSH);
                            { Set the text background color }
                            SetBkColor (wParam, rgbLightGray);
                        END; { case CtlColor_Static }

                END; { case }
            END; { case wm_CtlColor }
    END; { case }
END; { FileOpenHook }

(* ---- *)

PROCEDURE TStaticApp.InitMainWindow;
{ Create the window object }

BEGIN
    MainWindow := New (PStaticWindow, Init (NIL, 'MainDialog'));
END; { TStaticApp.InitMainWindow }

(* ---- *)

CONSTRUCTOR TStaticWindow.Init (AParent: PWindowsObject; ATitle: PChar);
{ Initialize the window object }

BEGIN
    INHERITED Init (AParent, ATitle); { Call ancestor }

    { Initialize the recessed/raised controls }
    { Statics }
    New (pToStaticUp, InitResource (@SELF, id_StaticUp, 25));
    New (pToStaticDown, InitResource (@SELF, id_StaticDown, 25));
    { Frames }
    New (pToFrameUp, InitResource (@SELF, id_FrameUp));
    New (pToFrameDown, InitResource (@SELF, id_FrameDown));
END; { TStaticWindow.Init }

(* ---- *)

PROCEDURE TStaticWindow.SetupWindow;
{ Initialize the controls }

BEGIN
    INHERITED SetupWindow; { Call ancestor }

    { Put some text into the static controls. Note the leading space. }
    pToStaticUp^.SetText (' Raised static control');
    pToStaticDown^.SetText (' Recessed static control');
END; { TStaticWindow.SetupWindow }

(* ---- *)

PROCEDURE TStaticWindow.GetWindowClass (VAR AWndClass: TWndClass);

BEGIN
    INHERITED GetWindowClass (AWndClass); { Vorfahre aufrufen }
END; { TStaticWindow.GetWindowClass }

(* ---- *)

FUNCTION TStaticWindow.GetClassName : PChar;

BEGIN
    GetClassName := szClassName;
END; { TStaticWindow.GetClassName }

(* ---- *)

PROCEDURE TStaticWindow.wmCommand (VAR Msg: TMessage);
{ Quit program if user presses ESC }

BEGIN
    IF (Msg.wParam = idCancel) THEN
    BEGIN
        PostMessage (hWindow, wm_Close, 0, 0);
        Msg.Result := 0;
    END { if }
    ELSE INHERITED wmCommand (Msg);
END; { TStaticWindow.wmCommand }

(* ---- *)

PROCEDURE TStaticWindow.idChooseFile (VAR Msg: TMessage);
{ User pressed the "Select a file" button }

CONST
    DefExt = 'exe';
    szFilter = 'Programs'#0'*.exe *.com *.bat *.pif'#0'All files'#0'*.*'#0#0;
    cPathLen = 100;

VAR
    pToOpenFN : POpenFileName;
    pacFilter, pacFileName, pacFullFileName : PChar;
    hWndEdit1, hWndEdit2 : hWnd;

BEGIN
    New (pToOpenFN);
    GetMem (pacFileName, cPathLen);
    GetMem (pacFullFileName, cPathLen);

    { Es wird kein Dateiname ⁿbergeben }
    lstrcpy (pacFileName,  '');
    lstrcpy (pacFullFileName, '');

    pacFilter := szFilter;

    FillChar (pToOpenFN^, SizeOf (TOpenFileName), #0); { Fill structure }


    WITH pToOpenFN^ DO
    BEGIN { Initialize structure }
        hInstance := System.hInstance; { Instance handle }
        hWndOwner := hWindow; { Handle of parent window }
        lpStrDefExt := DefExt; { Default extension }
        lpStrFile := pacFullFileName; { Initial filename }
        lpStrFilter := pacFilter; { The list with the extensions }
        lpStrFileTitle := pacFileName; { Full filename including path }
        lpStrTitle := 'Browse for a file'; { Dialog box title }
        { Various flags }
        Flags := ofn_FileMustExist OR ofn_HideReadOnly OR ofn_EnableHook;
        lStructSize := SizeOf (TOpenFileName); { Size of data structure }
        nFilterIndex := 1; { Select the first filter }
        nMaxFile := cPathLen - 1; { Size of buffer }
        lpfnHook := FileOpenHook; { Hook function. $K+ must be enabled!!! }
    END; { with }

    IF (GetOpenFileName (pToOpenFN^)) THEN
    BEGIN { Success }
        hWndEdit1 := GetDlgItem (hWindow, id_EditUp);
        hWndEdit2 := GetDlgItem (hWindow, id_EditDown);

        SetFocus (hWndEdit1);

        { Copy the filename into the parent window's edit controls }
        SendMessage (hWndEdit1, wm_SetText, 0, LongInt (pacFileName));
        SendMessage (hWndEdit2, wm_SetText, 0, LongInt (pacFileName));

        { Repaint the edit controls in the parent window in case that the
          user moved the "Browse for a file" dialog. Without the call to
          InvalidateRect the text in the edit controls won't get displayed
          correctly IF the dialog box is over the edit controls. }
        InvalidateRect (hWndEdit1, NIL, TRUE);
        InvalidateRect (hWndEdit2, NIL, TRUE);
    END; { if }

    Dispose (pToOpenFN);
    FreeMem (pacFileName, cPathLen);
    FreeMem (pacFullFileName, cPathLen);
END; { TStaticWindow.idChooseFile }

(* ---- *)

VAR
    StaticApp : TStaticApp;

BEGIN { StaticTest }
    WITH StaticApp DO
    BEGIN
        Init (szAppName);
        Run;
        Done;
    END; { with }
END. { StaticTest }